perm filename PGSAI.SAI[VIS,HPM] blob
sn#426075 filedate 1979-03-20 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY PTEXT,PTEXTD,PTXTTR,PRECTA,PELLIP,PPICFL,PPICFT
C00006 00003 OWN REAL XLO,YLO,XLIM,YLIM,XS,YS,DXS,DYS
C00010 00004 INTEGER PROCEDURE OPNPIC(STRING PFL INTEGER ARRAY PC)
C00013 00005 INTERNAL BOOLEAN PROCEDURE PPICFI(REAL X1,Y1,X2,Y2 STRING PFL)
C00019 00006 INTERNAL BOOLEAN PROCEDURE PPICFT(REAL X1,Y1,X2,Y2 STRING PFL)
C00025 ENDMK
C⊗;
ENTRY PTEXT,PTEXTD,PTXTTR,PRECTA,PELLIP,PPICFL,PPICFT;
BEGIN "PGSAI"
DEFINE PCLN=0; comment index of word in a picture file containing
number of scanlines in the picture;
DEFINE PCWD=1; comment number of words in the picture;
DEFINE PCBY=2; comment number of valid bytes in the picture;
DEFINE PCBYA=3; comment no. of bytes including the nulls at the end of lines;
DEFINE LNWD=4; comment no. of words per scanline;
DEFINE LNBY=5; comment no. of valid bytes per scanline;
DEFINE LNBYA=6; comment no. of bytes per scanline, including the nulls;
DEFINE WDBY=7; comment no. of bytes per word;
DEFINE WDBI=8; comment no. of bits containing data in a word;
DEFINE BYBI=9; comment no. of bits per byte;
DEFINE BMAX=10; comment maximum value of a byte;
DEFINE BPTAB=11; comment address of second entry in byte pntr. table;
DEFINE LINTAB=12; comment actual address of the first entry in the row table;
EXTERNAL PROCEDURE PRSFIL(STRING FILSPEC);
EXTERNAL STRING PROCEDURE DEVPRS;
EXTERNAL STRING PROCEDURE FILPRS;
EXTERNAL PROCEDURE PSCREM(REFERENCE REAL X1,Y1,X2,Y2);
EXTERNAL PROCEDURE PPHYSS(REFERENCE INTEGER PIC,YLO,XLO,YHI,XHI);
EXTERNAL PROCEDURE PDOT(REAL X1,Y1);
EXTERNAL PROCEDURE PLINE(REAL X1,Y1,X2,Y2);
EXTERNAL PROCEDURE PPOLYG(INTEGER N; REFERENCE REAL X,Y);
INTERNAL PROCEDURE PRECTA(REAL X1,Y1,X2,Y2);
BEGIN
REAL ARRAY X,Y[1:4];
X[1]←X1; Y[1]←Y1; X[2]←X1; Y[2]←Y2; X[3]←X2; Y[3]←Y2; X[4]←X2; Y[4]←Y1;
PPOLYG(4,X[1],Y[1]);
END;
INTERNAL PROCEDURE PELLIP(REAL X1,Y1,X2,Y2);
BEGIN
DEFINE NELP=64; PRELOAD_WITH 0; OWN REAL SAFE ARRAY S,C[1:NELP];
REAL SAFE ARRAY X,Y[1:NELP];
REAL CX,CY,RX,RY; INTEGER I;
IF S[1]=0 THEN FOR I←1 STEP 1 UNTIL NELP DO
BEGIN S[I]←SIN(I*3.14159*2/NELP); C[I]←COS(I*3.14159*2/NELP); END;
CX←(X1+X2)/2; CY←(Y1+Y2)/2; RX←(X2-X1)/2; RY←(Y2-Y1)/2;
FOR I←1 STEP 1 UNTIL 64 DO BEGIN X[I]←CX+RX*C[I]; Y[I]←CY+RY*S[I]; END;
PPOLYG(64,X[1],Y[1]);
END;
OWN REAL XLO,YLO,XLIM,YLIM,XS,YS,DXS,DYS;
INTERNAL PROCEDURE PTXTPO(REAL XPOS,YPOS,XSZ,YSZ,DXSZ(0.0),DYSZ(0.0));
BEGIN
XLIM←XPOS; XLO←XPOS; XS←XSZ; DXS←DXSZ;
YLIM←YPOS; YLO←YPOS; YS←YSZ; DYS←DYSZ;
END;
INTERNAL PROCEDURE PTEXT(STRING TXT);
BEGIN
EXTERNAL INTEGER LETAB;
INTEGER I,J,IL,JL,LETT,PNT;
WHILE LENGTH(TXT)>0 DO
BEGIN
LETT←LOP(TXT);
IF LETT='15 THEN BEGIN XLO←XLIM; YLO←YLIM; END ELSE
IF LETT='12 THEN BEGIN XLO←XLO-DXS; YLO←YLO-YS; END ELSE
IF LETT='11 THEN BEGIN XLO←XLO+4*XS; YLO←YLO+4*DYS; END ELSE
IF LETT='177 THEN BEGIN XLO←XLO-XS; YLO←YLO-DYS; END ELSE
IF LETT=0 THEN ELSE
BEGIN
PNT←POINT(3,MEMORY[LOCATION(LETAB)+3*LETT],-1);
J←ILDB(PNT); I←ILDB(PNT);
WHILE ¬(J=7 ∧ I=7) DO
BEGIN
IL←I; JL←J;
J←ILDB(PNT); I←ILDB(PNT);
IF J≠7 THEN
BEGIN
IF IL=7 THEN IL←-3; IF I=7 THEN I←-3;
PLINE(XLO+(JL/6)*XS+((IL)/10)*DXS,YLO+((IL)/10)*YS+(JL/6)*DYS,
XLO+(J/6)*XS+((I)/10)*DXS,YLO+((I)/10)*YS+(J/6)*DYS);
END
ELSE IF I=0 THEN BEGIN J←ILDB(PNT); I←ILDB(PNT); END;
END;
XLO←XLO+XS;
YLO←YLO+DYS;
END;
END;
END;
INTERNAL PROCEDURE PTEXTD(STRING TXT);
BEGIN
EXTERNAL INTEGER DOTLET;
INTEGER I,J,LETT,PNT;
WHILE LENGTH(TXT)>0 DO
BEGIN
LETT←LOP(TXT);
IF LETT='15 THEN BEGIN XLO←XLIM; YLO←YLIM; END ELSE
IF LETT='12 THEN BEGIN XLO←XLO-DXS; YLO←YLO-YS; END ELSE
IF LETT='11 THEN BEGIN XLO←XLO+4*XS; YLO←YLO+4*DYS; END ELSE
IF LETT='177 THEN BEGIN XLO←XLO-XS; YLO←YLO-DYS; END ELSE
IF LETT=0 THEN ELSE
BEGIN
PNT←POINT(1,MEMORY[LOCATION(DOTLET)+2*LETT],-1);
FOR I←0 STEP 1 UNTIL 9 DO
FOR J←0 STEP 1 UNTIL 5 DO
IF ILDB(PNT) THEN
BEGIN
REAL ARRAY X,Y[1:4];
X[1]←XLO+((J+.01)/6)*XS+((7.01-I)/10)*DXS;
Y[1]←YLO+((7.01-I)/10)*YS+((J+.01)/6)*DYS;
X[2]←XLO+((J+.99)/6)*XS+((7.01-I)/10)*DXS;
Y[2]←YLO+((7.01-I)/10)*YS+((J+.99)/6)*DYS;
X[3]←XLO+((J+.99)/6)*XS+((7.99-I)/10)*DXS;
Y[3]←YLO+((7.99-I)/10)*YS+((J+.99)/6)*DYS;
X[4]←XLO+((J+.01)/6)*XS+((7.99-I)/10)*DXS;
Y[4]←YLO+((7.99-I)/10)*YS+((J+.01)/6)*DYS;
PPOLYG(4,X[1],Y[1]);
END;
XLO←XLO+XS;
YLO←YLO+DYS;
END;
END;
END;
INTEGER PROCEDURE OPNPIC(STRING PFL; INTEGER ARRAY PC);
BEGIN
OWN INTEGER COUNT,BRCHAR,EOF,CH; BOOLEAN FLAG;
INTEGER I,J,K; INTEGER ARRAY BUF[0:20];
CH←GETCHAN; PRSFIL(PFL); EOF←TRUE;
OPEN(CH,DEVPRS,'10,19,0,COUNT,BRCHAR,EOF);
IF ¬EOF THEN LOOKUP(CH,FILPRS,FLAG);
IF FLAG ∨ EOF THEN
BEGIN
RELEASE(CH);
RETURN(-1);
END;
ARRYIN(CH,BUF[0],10);
IF BUF[0]=-1 THEN
BEGIN "new HE format"
ARRYIN(CH,BUF[10],9);
I←'200;
comment in case file is MIT pseudo stanford format, and has no pointers;
FOR K←18,17,16,15,10,9,8,7 DO IF BUF[K]≠0 THEN I←BUF[K];
PC[BYBI]←BUF[1];
PC[BMAX]←(1 LSH PC[BYBI])-1;
PC[LNBY]←BUF[6]-BUF[5]+1;
PC[PCLN]←BUF[4]-BUF[3]+1;
PC[WDBY]←36%PC[BYBI];
PC[LNWD]←BUF[2];
PC[LNBYA]←PC[LNWD]*PC[WDBY];
PC[PCWD]←PC[PCLN]*PC[LNWD];
PC[PCBY]←PC[PCLN]*PC[LNBY];
PC[PCBYA]←PC[PCLN]*PC[LNBYA];
PC[WDBI]←PC[WDBY]*PC[BYBI];
I←(I LAND '777777);
FOR J←I-1 STEP -1 UNTIL 19 DO WORDIN(CH); comment skip to first scanline;
END
ELSE
BEGIN comment if old hand eye format;
PC[BYBI]←BUF[2];
PC[BMAX]←(1 LSH PC[BYBI])-1;
PC[LNBY]←BUF[8]-BUF[7]+1;
PC[PCLN]←BUF[6]-BUF[5]+1;
PC[WDBY]←36%PC[BYBI];
PC[LNWD]←(PC[LNBY]+PC[WDBY]-1)%PC[WDBY];
PC[LNBYA]←PC[LNWD]*PC[WDBY];
PC[PCWD]←PC[PCLN]*PC[LNWD];
PC[PCBY]←PC[PCLN]*PC[LNBY];
PC[PCBYA]←PC[PCLN]*PC[LNBYA];
PC[WDBI]←PC[WDBY]*PC[BYBI];
IF PC[BYBI]≤0 ∨ PC[BYBI]>36 ∨ PC[LNBY]≤0 ∨ PC[PCLN]≤0 ∨ BUF[0]<0 THEN
BEGIN
RELEASE(CH);
RETURN(-1);
END;
END;
RETURN(CH);
END;
PRELOAD_WITH '777, '777, '377, '376, '372, '272, '270,'070, '030, '020, '000, '000;
OWN INTEGER ARRAY DOTS[-1:10];
INTERNAL BOOLEAN PROCEDURE PPICFI(REAL X1,Y1,X2,Y2; STRING PFL);
BEGIN "PICBLK"
INTEGER I,J,K,L,M,PL,LN,CH;
INTEGER PPIC,PYLO,PXLO,PYHI,PXHI;
INTEGER IDXL,IDYL,IDXH,IDYH,IDDX,IDDY;
REAL SXL,SYL,SXH,SYH,SDX,SDY, DXL,DYL,DXH,DYH, DDX,DDY, SX1,SY1,SX2,SY2;
INTEGER ARRAY PC[0:10];
IF (CH←OPNPIC(PFL,PC))<0 THEN RETURN(FALSE);
PPHYSS(PPIC,PYLO,PXLO,PYHI,PXHI); PSCREM(SX1,SY1,SX2,SY2);
DXL←PXLO+(PXHI-PXLO)*(X1-SX1)/(SX2-SX1); DXH←PXLO+(PXHI-PXLO)*(X2-SX1)/(SX2-SX1);
DYL←PYLO+(PYHI-PYLO)*(Y2-SY2)/(SY1-SY2); DYH←PYLO+(PYHI-PYLO)*(Y1-SY2)/(SY1-SY2);
PXLO←PXLO MAX 0; PXHI←PXHI MIN (MEMORY[PPIC+LNBY]-1);
PYLO←PYLO MAX 0; PYHI←PYHI MIN (MEMORY[PPIC+PCLN]-1);
SXL←0; SXH←PC[LNBY]-1; SYL←0; SYH←PC[PCLN]-1;
DDX←DXH-DXL; DDY←DYH-DYL; SDX←SXH-SXL; SDY←SYH-SYL;
IF DDY>0 THEN BEGIN
IF DYL<PYLO THEN BEGIN SYL←SYL-(DYL-PYLO)*SDY/DDY; DYL←PYLO; END;
IF DYH>PYHI THEN BEGIN SYH←SYH-(DYH-PYHI)*SDY/DDY; DYH←PYHI; END; END;
IF DDY<0 THEN BEGIN
IF DYH<PYLO THEN BEGIN SYH←SYH-(DYH-PYLO)*SDY/DDY; DYH←PYLO; END;
IF DYL>PYHI THEN BEGIN SYL←SYL-(DYL-PYHI)*SDY/DDY; DYL←PYHI; END; END;
IF DDX>0 THEN BEGIN
IF DXL<PXLO THEN BEGIN SXL←SXL-(DXL-PXLO)*SDX/DDX; DXL←PXLO; END;
IF DXH>PXHI THEN BEGIN SXH←SXH-(DXH-PXHI)*SDX/DDX; DXH←PXHI; END; END;
IF DDX<0 THEN BEGIN
IF DXH<PXLO THEN BEGIN SXH←SXH-(DXH-PXLO)*SDX/DDX; DXH←PXLO; END;
IF DXL>PXHI THEN BEGIN SXL←SXL-(DXL-PXHI)*SDX/DDX; DXL←PXHI; END; END;
IF SXL>SXH ∨ SYL>SYH THEN RETURN(TRUE);
IDDX←IF DDX<0 THEN -1 ELSE 1; IDDY←IF DDY<0 THEN -1 ELSE 1;
IDXL←(DXL+2*IDDX)%3; IDXH←(DXH-2*IDDX)%3;
IDYL←(DYL+2*IDDY)%3; IDYH←(DYH-2*IDDY)%3;
IF IDDX*(IDXH-IDXL)<0 ∨ IDDY*(IDYH-IDYL)<0 THEN RETURN(TRUE);
BEGIN
INTEGER LW; LABEL DOTPL,BPTDL,ERRSM,ERRSP,ERRSL,BPTSL,DUN; REAL BM;
INTEGER ARRAY DOTP[-1:10];
INTEGER ARRAY SCNLIN[0:PC[LNWD]-1],BPTS,BPTD[0:ABS(IDXH-IDXL)+1];
REAL ARRAY ERRS[-1:ABS(IDXH-IDXL)+2];
FOR J←-1 STEP 1 UNTIL 10 DO DOTP[J]←POINT(3,DOTS[J],26);
FOR J←IDXL STEP IDDX UNTIL IDXH DO
BEGIN
L←ABS(J-IDXL);
K←SXL+(SXH-SXL)*(J-IDXL)/(IDXH-IDXL);
BPTS[L]←POINT(PC[BYBI],SCNLIN[K%PC[WDBY]],((K MOD PC[WDBY])+1)*PC[BYBI]-1);
BPTD[L]←POINT(3,MEMORY[MEMORY[PPIC+LINTAB]+J%12],((J MOD 12)+1)*3-1);
END;
LW←MEMORY[PPIC+LNWD]; BM←9/PC[BMAX];
I←LOCATION(DOTP[0]); START_CODE MOVE 0,I; HRRM 0,DOTPL; END;
I←LOCATION(BPTD[0]); START_CODE MOVE 0,I; HRRM 0,BPTDL; END;
I←LOCATION(BPTS[0]); START_CODE MOVE 0,I; HRRM 0,BPTSL; END;
I←LOCATION(ERRS[0]); START_CODE MOVE 0,I; HRRM 0,ERRSL;
SUBI 0,1; HRRM 0,ERRSM; ADDI 0,2; HRRM 0,ERRSP; END;
PL←-1; FOR I←IDYL STEP IDDY UNTIL IDYH DO
BEGIN "YLOOP" DEFINE T=1, ER=3, J=2; INTEGER LWI,JJ;
LN←SYL+(SYH-SYL)*(I-IDYL)/(IDYH-IDYL); LWI←LW*3*I;
FOR PL←PL STEP 1 UNTIL LN DO ARRYIN(CH,SCNLIN[0],PC[LNWD]);
JJ←I LAND 1; ERRS[JJ-1]←0;
JJ←((JJ-ABS(IDXH-IDXL)-1) LSH 18) LOR JJ;
START_CODE "XLOOP"
MOVE J,JJ;
BPTSL: LDB ER,(J); FLTR ER,ER; FMPR ER,BM;
ERRSL: FADR ER,(J);
FIXR T,ER; FLTR 4,T; FSBR ER,4; FSC ER,'777777;
ERRSM: FADRM ER,(J);
ERRSP: MOVEM ER,(J);
DOTPL: MOVE 3,(T);
BPTDL: MOVE 4,(J); ADD 4,LWI;
ILDB T,3; DPB T,4; ADD 4,LW;
ILDB T,3; DPB T,4; ADD 4,LW;
ILDB T,3; DPB T,4;
AOBJP J,DUN; AOBJN J,BPTSL; DUN:
END "XLOOP";
END "YLOOP";
RELEASE(CH);
END;
RETURN(TRUE);
END "PICBLK";
INTERNAL BOOLEAN PROCEDURE PPICFT(REAL X1,Y1,X2,Y2; STRING PFL);
BEGIN "PICBLK"
INTEGER I,J,K,L,M,PL,LN,CH;
INTEGER PPIC,PYLO,PXLO,PYHI,PXHI;
INTEGER IDXL,IDYL,IDXH,IDYH,IDDX,IDDY;
REAL SXL,SYL,SXH,SYH,SDX,SDY, DXL,DYL,DXH,DYH, DDX,DDY, SX1,SY1,SX2,SY2;
INTEGER ARRAY PC[0:10];
IF (CH←OPNPIC(PFL,PC))<0 THEN RETURN(FALSE);
PPHYSS(PPIC,PYLO,PXLO,PYHI,PXHI); PSCREM(SX1,SY1,SX2,SY2);
DXL←PXLO+(PXHI-PXLO)*(X1-SX1)/(SX2-SX1); DXH←PXLO+(PXHI-PXLO)*(X2-SX1)/(SX2-SX1);
DYL←PYLO+(PYHI-PYLO)*(Y2-SY2)/(SY1-SY2); DYH←PYLO+(PYHI-PYLO)*(Y1-SY2)/(SY1-SY2);
PXLO←PXLO MAX 0; PXHI←PXHI MIN (MEMORY[PPIC+LNBY]-1);
PYLO←PYLO MAX 0; PYHI←PYHI MIN (MEMORY[PPIC+PCLN]-1);
SXL←0; SXH←PC[LNBY]-1; SYL←0; SYH←PC[PCLN]-1;
DDX←DXH-DXL; DDY←DYH-DYL; SDX←SXH-SXL; SDY←SYH-SYL;
IF DDY>0 THEN BEGIN
IF DYL<PYLO THEN BEGIN SXL←SXL-(DYL-PYLO)*SDX/DDY; DYL←PYLO; END;
IF DYH>PYHI THEN BEGIN SXH←SXH-(DYH-PYHI)*SDX/DDY; DYH←PYHI; END; END;
IF DDY<0 THEN BEGIN
IF DYH<PYLO THEN BEGIN SXH←SXH-(DYH-PYLO)*SDX/DDY; DYH←PYLO; END;
IF DYL>PYHI THEN BEGIN SXL←SXL-(DYL-PYHI)*SDX/DDY; DYL←PYHI; END; END;
IF DDX>0 THEN BEGIN
IF DXL<PXLO THEN BEGIN SYL←SYL-(DXL-PXLO)*SDY/DDX; DXL←PXLO; END;
IF DXH>PXHI THEN BEGIN SYH←SYH-(DXH-PXHI)*SDY/DDX; DXH←PXHI; END; END;
IF DDX<0 THEN BEGIN
IF DXH<PXLO THEN BEGIN SYH←SYH-(DXH-PXLO)*SDY/DDX; DXH←PXLO; END;
IF DXL>PXHI THEN BEGIN SYL←SYL-(DXL-PXHI)*SDY/DDX; DXL←PXHI; END; END;
IF SXL>SXH ∨ SYL>SYH THEN RETURN(TRUE);
IDDX←IF DDX<0 THEN -1 ELSE 1; IDDY←IF DDY<0 THEN -1 ELSE 1;
IDXL←(DXL+2*IDDX)%3; IDXH←(DXH-2*IDDX)%3;
IDYL←(DYL+2*IDDY)%3; IDYH←(DYH-2*IDDY)%3;
IF IDDX*(IDXH-IDXL)<0 ∨ IDDY*(IDYH-IDYL)<0 THEN RETURN(TRUE);
BEGIN
INTEGER LW; LABEL DOTPL,BPTDL,ERRSM,ERRSP,ERRSL,BPTSL,DUN; REAL BM;
INTEGER ARRAY DOTP[-1:10];
INTEGER ARRAY SCNLIN[0:PC[LNWD]-1],BPTS,BPTD[0:ABS(IDYH-IDYL)+1];
REAL ARRAY ERRS[-1:ABS(IDYH-IDYL)+2];
LW←MEMORY[PPIC+LNWD]; BM←9/PC[BMAX];
FOR J←-1 STEP 1 UNTIL 10 DO DOTP[J]←POINT(3,DOTS[J],26);
FOR J←IDYL STEP IDDY UNTIL IDYH DO
BEGIN
L←ABS(J-IDYL);
K←SXL+(SXH-SXL)*(J-IDYL)/(IDYH-IDYL);
BPTS[L]←POINT(PC[BYBI],SCNLIN[K%PC[WDBY]],((K MOD PC[WDBY])+1)*PC[BYBI]-1);
BPTD[L]←LW*3*J;
END;
I←LOCATION(DOTP[0]); START_CODE MOVE 0,I; HRRM 0,DOTPL; END;
I←LOCATION(BPTD[0]); START_CODE MOVE 0,I; HRRM 0,BPTDL; END;
I←LOCATION(BPTS[0]); START_CODE MOVE 0,I; HRRM 0,BPTSL; END;
I←LOCATION(ERRS[0]); START_CODE MOVE 0,I; HRRM 0,ERRSL;
SUBI 0,1; HRRM 0,ERRSM; ADDI 0,2; HRRM 0,ERRSP; END;
PL←-1; FOR I←IDXL STEP IDDX UNTIL IDXH DO
BEGIN "YLOOP" DEFINE T=1, ER=3, J=2; INTEGER LWI,JJ;
LN←SYL+(SYH-SYL)*(I-IDXL)/(IDXH-IDXL);
LWI←POINT(3,MEMORY[MEMORY[PPIC+LINTAB]+I%12],((I MOD 12)+1)*3-1);
FOR PL←PL STEP 1 UNTIL LN DO ARRYIN(CH,SCNLIN[0],PC[LNWD]);
JJ←I LAND 1; ERRS[JJ-1]←0;
JJ←((JJ-ABS(IDYH-IDYL)-1) LSH 18) LOR JJ;
START_CODE "XLOOP"
MOVE J,JJ;
BPTSL: LDB ER,(J); FLTR ER,ER; FMPR ER,BM;
ERRSL: FADR ER,(J);
FIXR T,ER; FLTR 4,T; FSBR ER,4; FSC ER,'777777;
ERRSM: FADRM ER,(J);
ERRSP: MOVEM ER,(J);
DOTPL: MOVE 3,(T);
BPTDL: MOVE 4,(J); ADD 4,LWI;
ILDB T,3; DPB T,4; ADD 4,LW;
ILDB T,3; DPB T,4; ADD 4,LW;
ILDB T,3; DPB T,4;
AOBJP J,DUN; AOBJN J,BPTSL; DUN:
END "XLOOP";
END "YLOOP";
RELEASE(CH);
END;
RETURN(TRUE);
END "PICBLK";
END;